home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbsrtbpm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-12  |  16.4 KB  |  453 lines
  1. (*=========================================================================*)
  2. (* Monitor conversion for BPQ-HOST                                         *)
  3. (*                                                                         *)
  4. (*  Copyright 1986, 1987, 1991 by H. Roy Engehausen.  All rights reserved. *)
  5. (*                                                                         *)
  6. (*=========================================================================*)
  7.  
  8. {$UNDEF DEBUG_MON1}
  9. {$UNDEF DEBUG_MON2} (* Used to decipher BPQ stuff *)
  10.  
  11. PROCEDURE bpq_monitor_convert;
  12.  
  13.   TYPE
  14.     ax25_call_str = STRING[9];
  15.  
  16.   VAR
  17.     address_ptr        : address_area_ptr_type;
  18.     address_overptr    : ^address_over ABSOLUTE address_ptr;
  19.     c_byte             : BYTE;
  20.     c_char             : CHAR;
  21.     control_ptr        : ^control_field;
  22.     control_string     : STRING[10];
  23.     cvt_string         : STRING[10];
  24.     data_len           : WORD;
  25.     data_ovr           : RECORD
  26.                            data_ofs : WORD;
  27.                            data_seg : WORD;
  28.                          END;
  29.     data_ptr           : POINTER ABSOLUTE data_ovr;
  30.     data_str           : ^STRING ABSOLUTE data_ovr;
  31.     digi_count         : BYTE;
  32.     i                  : BYTE;
  33.     pid_ptr            : ^pid_field;
  34.     pid_present        : BOOLEAN;
  35.     start_offset       : WORD;
  36.     test_byte          : BYTE;
  37.  
  38.   (*=========================================================================*)
  39.   (* Translate a AX25 callsign to printable characters                       *)
  40.   (*=========================================================================*)
  41.  
  42.   FUNCTION ax25_call(in_call : address_field) : ax25_call_str;
  43.  
  44.     (*-----------------------------------------------------------------------*)
  45.     (* Local variables                                                       *)
  46.     (*-----------------------------------------------------------------------*)
  47.  
  48.     VAR
  49.       i               : BYTE;
  50.       out_call        : ax25_call_str;
  51.  
  52.     BEGIN;
  53.  
  54.       (*---------------------------------------------------------------------*)
  55.       (* Loop around printing the characters one by one.  Skip blanks        *)
  56.       (* Don't forget we have to right shift it one bit.......               *)
  57.       (*---------------------------------------------------------------------*)
  58.  
  59.       i := 1;
  60.  
  61.       WHILE (i <= 6) AND (ORD(in_call.name[i]) <> (ORD(' ') * 2)) DO
  62.         BEGIN;
  63.           out_call[i] := CHR(ORD(in_call.name[i]) SHR 1);
  64.           INC(i);
  65.         END;
  66.  
  67.       (*---------------------------------------------------------------------*)
  68.       (* Set the output string length                                        *)
  69.       (*---------------------------------------------------------------------*)
  70.  
  71.       out_call[0] := CHR(i - 1);
  72.  
  73.       (*---------------------------------------------------------------------*)
  74.       (* Now see what the SSID is                                            *)
  75.       (*---------------------------------------------------------------------*)
  76.  
  77.       i := (in_call.addr_flag AND flag_ssid) SHR flag_ssid_shift;
  78.  
  79.       (*---------------------------------------------------------------------*)
  80.       (* If the SSID is not zero, display it too!                            *)
  81.       (*---------------------------------------------------------------------*)
  82.  
  83.       IF i <> 0 THEN
  84.         BEGIN;
  85.  
  86.           out_call := out_call + '-';
  87.  
  88.           IF i > 9 THEN
  89.             BEGIN;
  90.               i := i - 10;
  91.               out_call := out_call + '1';
  92.             END;
  93.  
  94.           i := ORD('0') + i;
  95.           out_call := out_call + CHR(i);
  96.  
  97.         END;
  98.  
  99.       (*---------------------------------------------------------------------*)
  100.       (* Set the function result and leave                                   *)
  101.       (*---------------------------------------------------------------------*)
  102.  
  103.       ax25_call := out_call;
  104.  
  105.     END; (*----- End subroutine to get AX25 call ----------------------------*)
  106.  
  107.   BEGIN;
  108.  
  109.     active_tcb^.tnc_type := t_to_h_mh_noi;
  110.  
  111.     (*-----------------------------------------------------------------------*)
  112.     (* Point to data area                                                    *)
  113.     (*-----------------------------------------------------------------------*)
  114.  
  115.     data_ptr := POINTER(active_tcb^.tnc_tth);
  116.  
  117.     {$IFDEF DEBUG_MON1}
  118.       dump_hex(data_ptr, tnc_registers.CX);
  119.     {$ENDIF}
  120.  
  121.     {$IFDEF DEBUG_MON2}
  122.       move(data_ptr^, control_string[1], 5);
  123.       control_string[0] := CHR(5);
  124.     {$ENDIF}
  125.  
  126.     (*-----------------------------------------------------------------------*)
  127.     (* Remove KISS header after we get the port number out of it             *)
  128.     (*-----------------------------------------------------------------------*)
  129.  
  130.     c_char := CHR((ORD(data_str^[2]) AND $0F) + ORD('0'));
  131.  
  132.     INC(data_ovr.data_ofs, 5);
  133.     start_offset := data_ovr.data_ofs;
  134.  
  135.     address_ptr := data_ptr;
  136.  
  137.     {$IFDEF DEBUG_MON1}
  138.       dump_hex(address_ptr, tnc_registers.CX);
  139.     {$ENDIF}
  140.  
  141.     IF tnc_registers.CX < 6 THEN
  142.       EXIT;
  143.  
  144.     DEC(tnc_registers.CX, 5);
  145.  
  146.     (*-----------------------------------------------------------------------*)
  147.     (* Compute digipeater count                                              *)
  148.     (*-----------------------------------------------------------------------*)
  149.  
  150.     digi_count := 0;
  151.     i          := address_ptr^.source.addr_flag AND flag_e;
  152.  
  153.     WHILE i = 0 DO
  154.       BEGIN;
  155.  
  156.         (*-------------------------------------------------------------------*)
  157.         (* Count the digipeater.  If now invalid # then die                  *)
  158.         (*-------------------------------------------------------------------*)
  159.  
  160.         INC(digi_count);
  161.         IF digi_count > max_ax25_digipeaters THEN
  162.           BEGIN;
  163.             WRITELN('Bad digicount --', digi_count);
  164.             dump_hex(address_ptr, 255);
  165.             EXIT;
  166.           END;
  167.  
  168.         (*-------------------------------------------------------------------*)
  169.         (* Test to see if last                                               *)
  170.         (*-------------------------------------------------------------------*)
  171.  
  172.         WITH address_ptr^.repeaters[digi_count] DO
  173.           i := addr_flag AND flag_e;
  174.  
  175.       END; (*----- End digipeater address loop ------------------------------*)
  176.  
  177.     (*-----------------------------------------------------------------------*)
  178.     (* Get more info we need                                                 *)
  179.     (*-----------------------------------------------------------------------*)
  180.  
  181.     control_ptr     := ADDR(address_overptr^[digi_count+3]);
  182.     c_byte          := control_ptr^ AND control_su;
  183.  
  184.     (*-----------------------------------------------------------------------*)
  185.     (* Build header -- Destination and source                                *)
  186.     (*-----------------------------------------------------------------------*)
  187.  
  188.     data_place.data_ptr^.str_data :=
  189.                        {$IFDEF DEBUG_MON2}
  190.                        c2x(control_string) +
  191.                        {$ENDIF}
  192.                        c_char +
  193.                        ':fm '  + ax25_call(address_ptr^.source) +
  194.                        ' to ' + ax25_call(address_ptr^.dest);
  195.  
  196.     (*-----------------------------------------------------------------------*)
  197.     (* Build header -- Repeater addresses                                    *)
  198.     (*-----------------------------------------------------------------------*)
  199.  
  200.     IF digi_count > 0 THEN
  201.       BEGIN;
  202.  
  203.         data_place.data_ptr^.str_data :=
  204.                                        data_place.data_ptr^.str_data + ' via';
  205.  
  206.         i := 0;
  207.  
  208.         WHILE i < digi_count DO
  209.           BEGIN;
  210.             i := i + 1;
  211.             data_place.data_ptr^.str_data :=
  212.                                        data_place.data_ptr^.str_data + ' ' +
  213.                                        ax25_call(address_ptr^.repeaters[i]);
  214.             test_byte := address_ptr^.repeaters[i].addr_flag AND flag_h;
  215.             IF test_byte <> 0 THEN
  216.               data_place.data_ptr^.str_data :=
  217.                                           data_place.data_ptr^.str_data + '*';
  218.           END;
  219.  
  220.       END;
  221.  
  222.     (*-----------------------------------------------------------------------*)
  223.     (* Build header -- Control field                                         *)
  224.     (*-----------------------------------------------------------------------*)
  225.  
  226.     pid_present := FALSE;
  227.  
  228.     test_byte := control_ptr^ AND NOT control_pf;
  229.  
  230.     CASE c_byte OF
  231.  
  232.       (*---------------------------------------------------------------------*)
  233.       (* I Frame                                                             *)
  234.       (*---------------------------------------------------------------------*)
  235.  
  236.       control_if1, control_if2:
  237.         BEGIN;
  238.  
  239.           IF (active_port^.mon_filter AND bpq_monitor_i) = 0 THEN
  240.             BEGIN;
  241.               active_tcb^.tnc_data.long_length := 0;
  242.               EXIT;
  243.             END;
  244.  
  245.           pid_present := TRUE;
  246.           control_string := 'Iab';
  247.           i := (test_byte AND control_nr) SHR control_nr_shift;
  248.           control_string[2] := CHR(i + ORD('0'));
  249.           i := (test_byte AND control_ns) SHR control_ns_shift;
  250.           control_string[3] := CHR(i + ORD('0'));
  251.  
  252.         END;
  253.  
  254.       (*---------------------------------------------------------------------*)
  255.       (* S Frame                                                             *)
  256.       (*---------------------------------------------------------------------*)
  257.  
  258.       control_sf:
  259.         BEGIN;
  260.  
  261.           IF (active_port^.mon_filter AND bpq_monitor_s) = 0 THEN
  262.             BEGIN;
  263.               active_tcb^.tnc_data.long_length := 0;
  264.               EXIT;
  265.             END;
  266.  
  267.           i := (test_byte AND control_nr) SHR control_nr_shift;
  268.           control_string := CHR(i + ORD('0'));
  269.           test_byte := test_byte AND control_sm;
  270.           CASE test_byte OF
  271.             control_rr:
  272.               control_string := 'RR' + control_string;
  273.             control_rnr:
  274.               control_string := 'RNR' + control_string;
  275.             control_rej:
  276.               control_string := 'REJ' + control_string;
  277.             ELSE
  278.               control_string := '?S' + b2x(control_ptr^);
  279.           END;
  280.  
  281.         END;
  282.  
  283.       (*---------------------------------------------------------------------*)
  284.       (* U Frame                                                             *)
  285.       (*---------------------------------------------------------------------*)
  286.  
  287.       control_uf:
  288.         BEGIN;
  289.  
  290.           test_byte := test_byte AND NOT control_pf;
  291.  
  292.           CASE test_byte OF
  293.             control_ui:
  294.               BEGIN;
  295.  
  296.                 IF (active_port^.mon_filter AND bpq_monitor_ui) = 0 THEN
  297.                   BEGIN;
  298.                     active_tcb^.tnc_data.long_length := 0;
  299.                     EXIT;
  300.                   END;
  301.  
  302.                 control_string := 'UI';
  303.                 pid_present    := TRUE;
  304.  
  305.               END;
  306.             control_dm:
  307.               control_string := 'DM';
  308.             control_sabm:
  309.               control_string := 'SABM';
  310.             control_disc:
  311.               control_string := 'DISC';
  312.             control_ua:
  313.               control_string := 'UA';
  314.             control_frmr:
  315.               control_string := 'FRMR';
  316.             ELSE
  317.               control_string := '?U' + b2x(control_ptr^);
  318.           END;
  319.  
  320.           IF (control_string <> 'UI')
  321.                 AND ((active_port^.mon_filter AND bpq_monitor_s) = 0) THEN
  322.             BEGIN;
  323.               active_tcb^.tnc_data.long_length := 0;
  324.               EXIT;
  325.             END;
  326.  
  327.         END; (*----- End of UI frames ---------------------------------------*)
  328.  
  329.     END; (*----- End of control frame type case statement -------------------*)
  330.  
  331.     data_place.data_ptr^.str_data := data_place.data_ptr^.str_data
  332.                                      + ' ctl ' + control_string;
  333.  
  334.     (*-----------------------------------------------------------------------*)
  335.     (* Build header -- p/f version                                           *)
  336.     (*      We are going to append 1 character that indicates the            *)
  337.     (*      state of the poll/final flag, the version flag, and the          *)
  338.     (*      command response state.  We will load i with a number            *)
  339.     (*      3 bits long which correspond to the settings of each             *)
  340.     (*      of the 3 bits tested.                                            *)
  341.     (*-----------------------------------------------------------------------*)
  342.  
  343.     test_byte := control_ptr^ AND control_pf;
  344.  
  345.     IF test_byte <> 0 THEN
  346.       i := 1
  347.     ELSE
  348.       i := 0;
  349.  
  350.     test_byte := address_ptr^.source.addr_flag AND flag_c;
  351.  
  352.     IF test_byte <> 0 THEN
  353.       i := i OR $02;
  354.  
  355.     test_byte := address_ptr^.dest.addr_flag AND flag_c;
  356.  
  357.     IF test_byte <> 0 THEN
  358.       i := i OR $04;
  359.  
  360.     CASE i OF
  361.       0, 6: c_char := ' ';         (* Ver 1 w/o p/f                    *)
  362.       1, 7: c_char := '.';         (* Ver 1 with p/f                   *)
  363.       2   : c_char := 'v';         (* Ver 2 response w/o p/f           *)
  364.       3   : c_char := '-';         (* Ver 2 response with p/f          *)
  365.       4   : c_char := '^';         (* Ver 2 command w/o p/f            *)
  366.       5   : c_char := '+';         (* Ver 2 command with p/f           *)
  367.     END;
  368.  
  369.     data_place.data_ptr^.str_data := data_place.data_ptr^.str_data + c_char;
  370.  
  371.     (*-----------------------------------------------------------------*)
  372.     (* Build header -- PID.. Also figure where the data area starts    *)
  373.     (*-----------------------------------------------------------------*)
  374.  
  375.     i := OFS(control_ptr^) + SIZEOF(control_field);
  376.     pid_ptr := PTR(SEG(control_ptr^), i);
  377.  
  378.     IF pid_present THEN
  379.       BEGIN;
  380.         IF (i - start_offset) < tnc_registers.CX THEN
  381.           BEGIN;
  382.  
  383.             CASE pid_ptr^ OF
  384.               $F0: i := bpq_monitor_F0;
  385.               $CF: i := bpq_monitor_CF;
  386.               ELSE
  387.                 i := bpq_monitor_other;
  388.             END;
  389.  
  390.             IF (active_port^.mon_filter AND i) = 0 THEN
  391.               BEGIN;
  392.                 active_tcb^.tnc_data.long_length := 0;
  393.                 EXIT;
  394.               END;
  395.  
  396.             data_place.data_ptr^.str_data := data_place.data_ptr^.str_data
  397.                                                      + ' pid ' + b2x(pid_ptr^);
  398.  
  399.           END
  400.         ELSE
  401.           data_place.data_ptr^.str_data := data_place.data_ptr^.str_data
  402.                                               + ' pid ??';
  403.         i := OFS(pid_ptr^) + SIZEOF(pid_field);
  404.         data_ptr := PTR(SEG(control_ptr^), i);
  405.       END
  406.     ELSE
  407.       data_ptr := ADDR(pid_ptr^);
  408.  
  409.     (*-----------------------------------------------------------------------*)
  410.     (* Compute the data length                                               *)
  411.     (*-----------------------------------------------------------------------*)
  412.  
  413.     i := i - start_offset;
  414.  
  415.     IF tnc_registers.CX > i THEN
  416.       data_len := tnc_registers.CX - i
  417.     ELSE
  418.       data_len := 0;
  419.  
  420.     (*-----------------------------------------------------------------------*)
  421.     (* If thats all the data then we are done                                *)
  422.     (*-----------------------------------------------------------------------*)
  423.  
  424.     IF (data_len < 1) THEN
  425.       BEGIN;
  426.         data_place.data_ptr^.long_length :=
  427.                                          LENGTH(data_place.data_ptr^.str_data);
  428.         EXIT;
  429.       END;
  430.  
  431.     (*-----------------------------------------------------------------------*)
  432.     (* Tack the data on the end of the message                               *)
  433.     (*-----------------------------------------------------------------------*)
  434.  
  435.     STR(data_len, cvt_string);
  436.     data_place.data_ptr^.str_data := data_place.data_ptr^.str_data
  437.                                                    + ' len ' + cvt_string + cr;
  438.  
  439.     i := LENGTH(data_place.data_ptr^.str_data);
  440.  
  441.     MOVE(data_ptr^, data_place.data_ptr^.str_data[i+1], data_len);
  442.  
  443.     INC(data_len, i);
  444.  
  445.     IF data_len >= 255 THEN
  446.       data_place.data_ptr^.str_data[0] := CHR(255)
  447.     ELSE
  448.       data_place.data_ptr^.str_data[0] := CHR(data_len);
  449.  
  450.     data_place.data_ptr^.long_length := data_len;
  451.  
  452.   END; (*----- End monitor print procedure ----------------------------*)
  453.